home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Applications / NIH Image 1.59 / 1.59 Source / Camera.p < prev    next >
Encoding:
Text File  |  1995-10-31  |  42.3 KB  |  1,542 lines  |  [TEXT/PJMM]

  1. unit Camera;
  2.  
  3. {Routines used by the NIH Image to support Data Translation
  4. and Scion (LG-3, AG-5 or VG-5) frame grabber cards, and
  5. QuickTime compatible digitizers.}
  6.  
  7. interface
  8.  
  9.  
  10.     uses
  11.         Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils,
  12.         OSUtils,Resources, Errors, Palettes, QuickTimeComponents, GestaltEqu,
  13.         globals, Utilities, Graphics, File1, Analysis;
  14.  
  15.  
  16.     function DoAveragingOptions: boolean;
  17.     procedure AverageFrames;
  18.     procedure GetFrame;
  19.     procedure CaptureAndDisplayFrame;
  20.     procedure HighlightPixels;
  21.     procedure ShowTriggerMessage;
  22.     procedure StartDigitizing;
  23.     procedure StopDigitizing;
  24.     procedure SetVideoChannel;
  25.     function GetFGPixel (h, v: integer): integer;
  26.     procedure WaitForTrigger;
  27.     procedure ShowChannel;
  28.     procedure ShowVideoControl;
  29.     procedure UpdateVideoControl;
  30.     procedure DoVideoControl (item: integer);
  31.     procedure SelectCameraWindow;
  32.     procedure SetOffset (var offset, gain: integer);
  33.     procedure SetGain (var offset, gain: integer);
  34.     procedure ShowOffsetAndGain (offset, gain: integer);
  35.     procedure ShowVideoDialog;
  36.  
  37.  
  38.  
  39. implementation
  40.  
  41. type
  42.     IntPtr = ^integer;
  43.  
  44. var
  45.     SavePicBaseAddr: ptr;
  46.     StopFlagLoc: IntPtr;
  47.  
  48.  
  49. procedure GetGrabDepth(var bitDepth: LongInt; var vdigInfo: DigitizerInfo);
  50. begin
  51.     if VDGetDigitizerInfo(vdig, vdigInfo) = noErr then begin
  52.         if DigitizerMode = digitizeGrayscale then begin
  53.             if band(vdigInfo.outputCapabilityFlags, digiOutDoes8) <> 0 then
  54.                 bitDepth := 8 {first choice}
  55.             else if band(vdigInfo.outputCapabilityFlags, digiOutDoes32) <> 0 then
  56.                 bitDepth := 32 {second choice}
  57.             else if (band(vdigInfo.outputCapabilityFlags, digiOutDoes16) <> 0) then
  58.                     bitDepth := 16; {last choice}
  59.         end else begin {capture color}
  60.             if band(vdigInfo.outputCapabilityFlags, digiOutDoes32) <> 0 then
  61.                 bitDepth := 32 {first choice}
  62.             else if band(vdigInfo.outputCapabilityFlags, digiOutDoes16) <> 0 then
  63.                 bitDepth := 16 {second choice}
  64.             else if (band(vdigInfo.outputCapabilityFlags, digiOutDoes8) <> 0) then
  65.                     bitDepth := 8; {last choice}
  66.         end;
  67.     end;
  68.     ShowMessage(StringOf('grab depth=', bitDepth));
  69. end;
  70.  
  71.  
  72. procedure SetVideoStandard(var vdigInfo: DigitizerInfo);
  73. var
  74.     err: ComponentResult;
  75.     inFlags, outFlags: LongInt;
  76. begin
  77.     case DigitizerStandard of
  78.         NTSCStd: if band(vdigInfo.inputCapabilityFlags, digiInDoesNTSC) <> 0 then
  79.                         err := VDSetInputStandard(vdig, ntscIn);
  80.         PALStd: if band(vdigInfo.inputCapabilityFlags, digiInDoesPAL) <> 0 then
  81.                         err := VDSetInputStandard(vdig, palIn);
  82.         SECAMStd: if band(vdigInfo.inputCapabilityFlags, digiInDoesSECAM) <> 0 then
  83.                         err := VDSetInputStandard(vdig, secamIn);
  84.         otherwise;
  85.     end;
  86.     err := VDGetCurrentFlags(vdig, inFlags, outFlags);
  87.     if err = noErr then
  88.         if band(inFlags, digiInDoesNTSC) <> 0 then
  89.                         DigitizerStandard := NTSCStd
  90.         else if band(inFlags, digiInDoesPAL) <> 0 then
  91.                         DigitizerStandard := PALStd
  92.         else if band(inFlags, digiInDoesSECAM) <> 0 then
  93.                         DigitizerStandard := SECAMStd;
  94. end;
  95.  
  96.  
  97. procedure SetupVdig;
  98. var
  99.     mPtr: MatrixRecordPtr;
  100.     vdErr: ComponentResult;
  101.     vdigInfo: DigitizerInfo;
  102.     DummyMatrixRecord, bitDepth: LongInt;
  103.     err: OSErr;
  104.     flags: GWorldFlags;
  105.     SaveGDevice: GDHandle;
  106.     gwRect: rect;
  107. begin
  108.     SetRect(gwRect, 0, 0, fgWidth, fgHeight);
  109.     bitDepth := 8;
  110.     if VDGetDigitizerInfo(vdig, vdigInfo) = noErr then begin
  111.         GetGrabDepth(bitDepth, vdigInfo);
  112.         SetVideoStandard(vdigInfo);
  113.     end;
  114.     if bitDepth = 8 then
  115.         vdErr := VDSetInputColorSpaceMode(vdig, 0); {grayscale}
  116.     SaveGDevice := GetGDevice;
  117.     SetGDevice(osGDevice);
  118.     if bitDepth = 8 then
  119.         GWorldLUT := GetCTable(40) {grayscale LUT}
  120.     else
  121.         GWorldLUT := nil;
  122.     flags := 0;
  123.     err := NewGWorld(osGWorld, bitDepth, gwRect, GWorldLUT, nil, flags);
  124.     SetGDevice(SaveGDevice);
  125.     if err <> NoErr then begin
  126.             PutMemoryAlert;
  127.             CloseVdig;
  128.             exit(SetupVdig);
  129.         end;
  130.     fgPixMap := GetGWorldPixMap(osGWorld);
  131.     if not LockPixels(fgPixMap) then begin
  132.             CloseVdig;
  133.             exit(SetupVdig);
  134.         end;
  135.     DummyMatrixRecord := LongInt(nil);
  136.     mPtr := MatrixRecordPtr(ptr(DummyMatrixRecord));
  137.     vdErr := VDSetPlayThruDestination(vdig, fgPixMap, gwRect, MatrixRecord(mPtr^), nil);
  138.     if vdErr <> noErr then begin
  139.         CloseVdig;
  140.         PutError(StringOf('Video digitizer error ', vdErr));
  141.     end;
  142. end;
  143.  
  144.  
  145. procedure LookForVDig;
  146. {Look for a QuickTime video digitizer component}
  147. var
  148.     result: LongInt;
  149.     videoDesc: ComponentDescription;
  150.     srcRrect: rect;
  151.     vdErr: ComponentResult;
  152.     vdigID: Component;
  153. begin
  154.     if Gestalt(gestaltQuickTime, result) <> noErr then begin
  155.         ShowMessage('No QuickTime');
  156.         exit(LookForVDig);
  157.     end;
  158.     videoDesc.componentType := VideoDigitizerComponentType;
  159.     videoDesc.componentSubType := OSType(0); {any subtype}
  160.     if UseBuiltinDigitizer then
  161.         videoDesc.componentManufacturer := 'appl'
  162.     else
  163.         videoDesc.componentManufacturer := OSType(0);
  164.     videoDesc.componentFlags := 0;
  165.     videoDesc.componentFlagsMask := 0;
  166.     vdigID :=FindNextComponent(Component(0), videoDesc);
  167.     if vdigID = Component(0) then begin
  168.         videoDesc.componentManufacturer := OSType(0); {any manufacturer}
  169.         vdigID :=FindNextComponent(Component(0), videoDesc);
  170.         if vdigID = Component(0) then begin
  171.             ShowMessage('No vdig found');
  172.             exit(LookForVDig);
  173.         end;
  174.     end;
  175.     vdig := OpenComponent(vdigID);
  176.     if vdig = nil then begin
  177.       ShowMessage('Unable to open vdig');
  178.         exit(LookForVDig);
  179.     end;
  180.     vdErr := VDGetDigitizerRect(vdig, srcRrect);
  181.     {vdErr := VDGetActiveSrcRect(vdig, 0, srcRrect);}
  182.     if vdErr = noErr then with srcRrect do begin
  183.         fgWidth := (right - left) div fgScale;
  184.         fgHeight := (bottom - top) div fgScale;
  185.     end else begin
  186.         fgWidth := 320;
  187.         fgHeight := 240;
  188.     end;
  189.     FrameGrabber := QTvdig;
  190.     SetupVdig;
  191. end;
  192.  
  193.  
  194. procedure CorrectShadingOfLine (PicPtr, BFPtr: ptr; width, BFMean: integer);
  195. {$IFC PowerPC}
  196. VAR
  197.   PicLine,BFLine:LinePtr;
  198.   i,value:LongInt;
  199. BEGIN
  200.   PicLine:=LinePtr(PicPtr);
  201.   BFLine:=LinePtr(BFPtr);
  202.   FOR i:=0 TO width-1 DO BEGIN
  203.     value:=PicLine^[i];
  204.     value:=255-value;
  205.     value:=(value * BFMean + (BFLine^[i] div 2)) DIV BFLine^[i];
  206.     IF value>254 THEN value:=254;
  207.     IF value<1 THEN value:=1;
  208.     PicLine^[i]:=255-value;
  209.   END;
  210. END;
  211. {$ELSEC}
  212.   {a0=data pointer}
  213.   {a1=blank field data pointer}
  214.   {d0=count}
  215.   {d1=pixel value}
  216.   {d2=blank field pixel value}
  217.   {d3=blank field mean}
  218.   {d4=temp}
  219.   {d5=max pixel value(245)}
  220.   {d6=min pixel value(1)}
  221.     inline
  222.         $4E56, $0000, {   link    a6,#0}
  223.         $48E7, $FEC0, {   movem.l    a0-a1/d0-d6,-(sp)}
  224.         $206E, $000C, {   move.l    12(a6),a0}
  225.         $226E, $0008, {   move.l    8(a6),a1}
  226.         $4280,       {   clr.l    d0}
  227.         $302E, $0006, {   move.w    6(a6),d0}
  228.         $362E, $0004, {   move.w    4(a6),d3}
  229.         $2A3C, $0000, $00FE, {   move.l    #254,d5}
  230.         $2C3C, $0000, $0001, {   move.l    #1,d6}
  231.         $5380,       {   subq.l    #1,d0}
  232.         $4281,       {   clr.l    d1}
  233.         $4282,       {   clr.l    d2}
  234.         $1210,       {L1    move.b    (a0),d1}
  235.         $1419,       {   move.b    (a1)+,d2}
  236.         $4601,       {   not.b    d1}
  237.         $C2C3,       {   mulu.w    d3,d1}
  238.         $2802,       {   move.l    d2,d4}
  239.         $E244,       {   asr.w    #1,d4}
  240.         $D284,       {   add.l    d4,d1}
  241.         $82C2,       {   divu.w    d2,d1}
  242.         $B245,       {   cmp.w    d5,d1}
  243.         $6F02,       {   ble.s    L2}
  244.         $3205,       {   move.w    d5,d1}
  245.         $B246,       {L2    cmp.w    d6,d1}
  246.         $6C02,       {   bge.s    L3}
  247.         $3206,       {   move.w    d6,d1}
  248.         $4601,       {L3    not.b    d1}
  249.         $10C1,       {   move.b    d1,(a0)+}
  250.         $51C8, $FFDE, {   dbra    d0,L1}
  251.         $4CDF, $037F, {   movem.l    (sp)+,a0-a1/d0-d6}
  252.         $4E5E,       {   unlk    a6}
  253.         $DEFC, $000C; {   add.w    #12,sp}
  254. {$ENDC}
  255.  
  256.  
  257.     procedure CorrectShading;
  258.         var
  259.             i, tag, width: integer;
  260.             offset, NextUpdate: LongInt;
  261.             p1, p2: ptr;
  262.             str: str255;
  263.             MaskRect:rect;
  264.     begin
  265.         with info^ do begin
  266.                 if ImageSize <> BlankFieldInfo^.ImageSize then begin
  267.                         beep;
  268.                         exit(CorrectShading);
  269.                     end;
  270.                 ShowWatch;
  271.                 tag:=0;
  272.                 NextUpdate:=TickCount+6;
  273.                 width:=PicRect.right;
  274.                 p1 := PicBaseAddr;
  275.                 p2 := BlankFieldInfo^.PicBaseAddr;
  276.                 for i := 1 to nLines do begin
  277.                         CorrectShadingOfLine(p1, p2, PixelsPerLine, BlankFieldMean);
  278.                         p1 := ptr(ord4(p1) + info^.BytesPerRow);
  279.                         p2 := ptr(ord4(p2) + BlankFieldInfo^.BytesPerRow);
  280.                     if TickCount>=NextUpdate then begin
  281.                             SetRect(MaskRect, 0, tag, width, i);
  282.                             UpdateScreen(MaskRect);
  283.                             tag:=i;
  284.                             NextUpdate:=TickCount+6;
  285.                         end;
  286.                     end;
  287.                 SetRect(MaskRect, 0, tag, width, nLines);
  288.                 UpdateScreen(MaskRect);
  289.                 str := title;
  290.                 if SpatiallyCalibrated then
  291.                     str := concat(str, chr($13)); {Black Diamond}
  292.                 if fit <> uncalibrated then
  293.                     str := concat(str, '');
  294.                 if wptr <> nil then
  295.                     SetWTitle(wptr, concat(str, ' (Corrected)'));
  296.             end;
  297.     end;
  298.  
  299.  
  300.     procedure StopDigitizing;
  301.     begin
  302.         if digitizing then
  303.             with info^ do begin
  304.                     ShowFrameRate('', fgStartTicks, fgFrameCount);
  305.                     CopyOffscreen(fgPixMap, osPort^.portPixMap, PicRect, PicRect);
  306.                     if vdig <> nil then
  307.                         UpdatePicWindow;
  308.                     SetMenuItemText(SpecialMenuH, StartItem, 'Start Capturing');
  309.                     Digitizing := false;
  310.                     ContinuousHistogram := false;
  311.                     with info^ do
  312.                         if PictureType = FrameGrabberType then begin
  313.                                 title := 'Camera';
  314.                                 UpdateTitleBar;
  315.                                 if HighlightSaturatedPixels then
  316.                                     LoadLUT(ctable);
  317.                             end;
  318.                     if (ScreenDepth<>8) and HighlightSaturatedPixels then
  319.                         UpdatePicWindow;
  320.                     if (BlankFieldInfo <> nil) and not OptionKeyDown then
  321.                         CorrectShading;
  322.                 end;
  323.     end;
  324.  
  325.  
  326.     procedure GetFrame;
  327.         var
  328.             ticks, timeout: LongInt;
  329.             temp:integer;
  330.             vdigErr: ComponentResult;
  331.     begin
  332.             case FrameGrabber of
  333.             
  334.                 ScionLG3, ScionVG5f:
  335.                     if ExternalTrigger then begin {Wait for trigger}
  336.                             ControlReg^ := $90;
  337.                             repeat
  338.                                 if button then
  339.                                     ExternalTrigger := false;
  340.                             until (band(ControlReg^, $80) = $80) or not ExternalTrigger;
  341.                             ControlReg^ := 0;
  342.                             if Digitizing then
  343.                                 StopDigitizing;
  344.                             UpdateVideoControl;
  345.                         end {if External Trigger}
  346.                     else begin
  347.                             TimeOut := TickCount + 30;  {1/2sec. timeout}
  348.                             ControlReg^ := $80; {Start frame capture}
  349.                             while band(ControlReg^, $80) = 0 do begin    {Wait for it to complete}
  350.                                     if TickCount > TimeOut then begin
  351.                                             ControlReg^ := 0;
  352.                                             leave
  353.                                         end;
  354.                                 end;
  355.                             ControlReg^ := 0;
  356.                         end;
  357.                 
  358.             ScionAG5:
  359.                     if ExternalTrigger then begin {Wait for trigger}
  360.                             ControlReg^ := bor(bor(ord(AG5GrabMode), $90), bsl(ord(AG5LutMode and not ControlKeyDown), 2));
  361.                             repeat
  362.                                 if button then
  363.                                     ExternalTrigger := false;
  364.                             until (band(ControlReg^, $80) = $80) or not ExternalTrigger;
  365.                             ControlReg^ := 0;
  366.                             if Digitizing then
  367.                                 StopDigitizing;
  368.                             UpdateVideoControl;
  369.                         end {if External Trigger}
  370.                     else begin
  371.                             TimeOut := TickCount + 30;  {1/2sec. timeout}
  372.                             ControlReg^ := bor(bor(ord(AG5GrabMode), $80), bsl(ord(AG5LutMode and not ControlKeyDown), 2)); {Start frame capture}
  373.                             repeat
  374.                                 if TickCount > TimeOut then
  375.                                     leave;
  376.                                 temp:=ControlReg^; {ppc-bug}
  377.                             until band(temp, $80) <> 0; {Wait for it to complete}
  378.                             ControlReg^ := 0;
  379.                         end;
  380.                         
  381.             QuickCapture:
  382.                 if ExternalTrigger then begin {Wait for trigger}
  383.                         ControlReg^ := $82; {Set Busy and External Trigger Enable bits}
  384.                         repeat
  385.                             if button then
  386.                                 ExternalTrigger := false;
  387.                             temp:=ControlReg^; {ppc-bug}
  388.                         until (band(temp, $80) = 0) or not ExternalTrigger;
  389.                         if Digitizing then
  390.                             StopDigitizing;
  391.                         UpdateVideoControl;
  392.                     end {if External Trigger}
  393.                 else begin
  394.                         TimeOut := TickCount + 30;  {1/2sec. timeout}
  395.                         ControlReg^ := $80; {Start frame capture by setting busy bit}
  396.                         repeat
  397.                             if TickCount > TimeOut then
  398.                                 leave;
  399.                             temp:=ControlReg^; {ppc-bug}
  400.                         until band(temp, $80) = 0; {Wait for frame capture to complete}
  401.                     end;
  402.             
  403.             QTvdig: begin
  404.                             if ExternalTrigger then begin {Wait for mouse press}
  405.                                 repeat
  406.                                 until button;
  407.                                 ExternalTrigger := false;
  408.                             end;
  409.                             if vdig <> nil then
  410.                                 vdigErr := VDGrabOneFrame(vdig);
  411.                     end;
  412.                 
  413.         end; {case}
  414.         fgFrameCount := fgFrameCount + 1;
  415.     end;
  416.  
  417.  
  418.     procedure CaptureAndDisplayFrame;
  419.         var
  420.             tPort: GrafPtr;
  421.             SaveGDevice: GDHandle;
  422.     begin
  423.         with info^ do begin
  424.                 if (PictureType <> FrameGrabberType) or (PixelsPerLine <> fgWidth) or (nlines <> fgHeight) then begin
  425.                         Digitizing := false;
  426.                         exit(CaptureAndDisplayFrame);
  427.                     end;
  428.                 GetFrame;
  429.                 SaveGDevice := GetGDevice;
  430.                 SetGDevice(GetMainDevice);
  431.                 getPort(tPort);
  432.                 SetPort(wptr);
  433.                 SetFColor(BlackIndex);
  434.                 SetBColor(WhiteIndex);
  435.                 if (FrameGrabber = QTvdig) and (LUTMode <> grayscale) and (ScreenDepth <= 8) then
  436.                     CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, ditherCopy, nil)
  437.                 else
  438.                     CopyBits(BitMapHandle(fgPixMap)^^, BitMapHandle(CGrafPtr(wptr)^.PortPixMap)^^, SrcRect, wrect, srcCopy, nil);
  439.                 SetPort(tPort);
  440.                 SetGDevice(SaveGDevice);
  441.             end;
  442.     end;
  443.  
  444.  
  445.     procedure SetReg (index, value: integer);
  446.         const
  447.             RegOffset = $f5fe0;
  448.         var
  449.             reg: ptr;
  450.     begin
  451.         reg := ptr(fgSlotBase + RegOffset + index * 4);
  452.         reg^ := value;
  453.     end;
  454.  
  455.  
  456.     {$ifc PowerPC} {ppc-bug}
  457.     procedure SwapMMUMode(var mode:SignedByte);
  458.     begin
  459.     end;
  460.     {$endc}
  461.     
  462.     
  463.     procedure SelectCameraWindow;
  464.   {If there is a Camera window, activate it, otherwise, do nothing.}
  465.         var
  466.             i: integer;
  467.             TempInfo: InfoPtr;
  468.     begin
  469.         for i := 1 to nPics do begin
  470.                 TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
  471.                 if TempInfo^.PictureType = FrameGrabberType then begin
  472.                         if PicWindow[i] <> nil then begin
  473.                                 if OpPending then
  474.                                     KillRoi;
  475.                                 SelectWindow(PicWindow[i]);
  476.                                 Info := TempInfo;
  477.                                 ActivateWindow;
  478.                             end; {if}
  479.                         leave;
  480.                     end; {if}
  481.             end; {for}
  482.     end;
  483.  
  484.  
  485.     procedure HighlightPixels;
  486.         var
  487.             lut: MyCSpecArray;
  488.     begin
  489.         with info^ do begin
  490.                 lut := ctable;
  491.                 lut[1].rgb := Highlight1;
  492.                 lut[254].rgb := Highlight254;
  493.                 LoadLUT(lut);
  494.             end;
  495.     end;
  496.  
  497.  
  498.     procedure ShowTriggerMessage;
  499.     begin
  500.         if ExternalTrigger and (frameGrabber <> noFrameGrabber) then
  501.             ShowMessage(concat('EXTERNAL TRIGGER MODE', crStr, '(Press mouse button to exit)'));
  502.     end;
  503.  
  504.  
  505.     procedure StartDigitizing;
  506.         var
  507.             i, width, height: integer;
  508.             trect: rect;
  509.             NewWindow: boolean;
  510.     begin
  511.         if FrameGrabber = NoFrameGrabber then
  512.             LookForVDig;
  513.         if Digitizing then begin
  514.                 StopDigitizing;
  515.                 if BlankFieldInfo <> nil then
  516.                     wait(15);
  517.                 FlushEvents(EveryEvent, 0); {In case user holds key down too long}
  518.                 exit(StartDigitizing)
  519.             end;
  520.         if FrameGrabber = NoFrameGrabber then begin
  521.                 PutError('Capturing requires a Data Translation, Scion or QuickTime compatible frame grabber.');
  522.                 AbortMacro;
  523.                 exit(StartDigitizing)
  524.             end;
  525.         if info^.PictureType <> FrameGrabberType then
  526.             SelectCameraWindow;
  527.         NewWindow := false;
  528.         with info^ do
  529.             if (PictureType <> FrameGrabberType) or (PixelsPerLine <> fgWidth) or (nlines <> fgHeight) then begin
  530.                     if not NewPicWindow('Camera', fgWidth, fgHeight) then
  531.                         exit(StartDigitizing);
  532.                     if FrameGrabber = QTvdig then with info^ do begin
  533.                         fgPort := osPort;
  534.                         fgSlotBase := LongInt(PicBaseAddr);
  535.                         fgRowBytes := BytesPerRow;
  536.                     end;
  537.                     NewWindow := true;
  538.                 end;
  539.         with info^ do begin
  540.                 PictureType := FrameGrabberType;
  541.                 if NewWindow and (not EqualRect(SrcRect, PicRect)) then {Center Frame}
  542.                     with SrcRect do begin
  543.                             width := right - left;
  544.                             height := bottom - top;
  545.                             left := (PicRect.right - width) div 2;
  546.                             right := left + width;
  547.                             top := (PicRect.bottom - height) div 2;
  548.                             bottom := top + height;
  549.                         end;
  550.                 KillRoi;
  551.                 if ScaleToFitWindow then
  552.                     ScaleToFit;
  553.                 with SrcRect do begin
  554.                         width := right - left;
  555.                         left := band(left, $fffc);
  556.                         right := left + width;
  557.                     end;
  558.                 GetWindowRect(wptr, trect);
  559.                 with trect do
  560.                     if band(left, 3) <> 0 then
  561.                         MoveWindow(wptr, band(left, $fffc), top, true); {Forces window to be word aligned}
  562.                 with SrcRect do {Prevents bus errors when Camera window moved.}
  563.                     if (top = 0) and (bottom < PicRect.bottom) then begin
  564.                             top := top + 1;
  565.                             bottom := bottom + 1;
  566.                         end;
  567.                 ResetFrameGrabber;
  568.                 Digitizing := true;
  569.                 SetMenuItemText(SpecialMenuH, StartItem, 'Stop Capturing');
  570.                 changes := true;
  571.                 BinaryPic := false;
  572.                 UpdateTitleBar;
  573.                 if HighlightSaturatedPixels then
  574.                     HighlightPixels;
  575.             end; {with info}
  576.         fgFrameCount := 0;
  577.         fgStartTicks := TickCount;
  578.         ContinuousHistogram := false;
  579.         ShowTriggerMessage;
  580.     end;
  581.  
  582.  
  583.     procedure AddLineToSum (src, dst: ptr; width: LongInt);
  584. {$IFC PowerPC}
  585.         type
  586.             SumLineType = array[0..2047] of integer;
  587.             fptr = ^SumLineType;
  588.         var
  589.             FrameLine: LinePtr;
  590.             SumLine: fptr;
  591.             i: integer;
  592.     begin
  593.         FrameLine := LinePtr(src);
  594.         SumLine := fptr(dst);
  595.         for i := 0 to width - 1 do
  596.             SumLine^[i] := SumLine^[i] + FrameLine^[i];
  597.     end;
  598. {$ELSEC}
  599. inline
  600. {a0=data pointer}
  601. {a1=sum buffer pointer}
  602. {d0=count}
  603. {d1=pixel value}
  604. {d2=temp}
  605.     $4E56, $0000, {link    a6,#0}
  606.     $48E7, $E0C0, {movem.l    a0-a1/d0-d2,-(sp)}
  607.     $206E, $000C, {move.l    12(a6),a0}
  608.     $226E, $0008, {move.l    8(a6),a1}
  609.     $202E, $0004, {move.l    4(a6),d0}
  610.     $5380,              {subq.l    #1,d0}
  611.     $4281,              {clr.l    d1}
  612.     $4282,              {clr.l    d2}
  613.     $1218,              {L1    move.b    (a0)+,d1}
  614.     $3411,              {move.w    (a1),d2}
  615.     $D441,              {add.w      d1,d2}
  616.     $32C2,              {move.w    d2,(a1)+}
  617.     $51C8, $FFF6, {dbra    d0,L1}
  618.     $4CDF, $0307, {movem.l    (sp)+,a0-a1/d0-d2}
  619.     $4E5E,               {unlk    a6}
  620.     $DEFC, $000C; {add.w    #12,sp}
  621. {$ENDC}
  622.  
  623.  
  624. function DoAveragingOptions: boolean;
  625.     const
  626.         FramesID = 8;
  627.         VideoRateID = 9;
  628.         SumID = 10;
  629.         ShowID = 11;
  630.         FixID = 12;
  631.         MinID = 13;
  632.         MaxID = 14;
  633.         OnChipID = 15;
  634.     var
  635.         mylog: DialogPtr;
  636.         item, i: integer;
  637. begin
  638.     InitCursor;
  639.     mylog := GetNewDialog(140, nil, pointer(-1));
  640.     if not SumFrames then begin
  641.             ShowIntegratedValues := false;
  642.             FixIntegrationScale := false;
  643.         end;
  644.     SetDNum(MyLog, FramesID, FramesToAverage);
  645.     SetDlogItem(mylog, SumID, ord(SumFrames));
  646.     SetDlogItem(mylog, VideoRateID, ord(VideoRateAveraging));
  647.     SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  648.     SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  649.     SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  650.     SetDNum(MyLog, MinID, IntegrationMin);
  651.     SetDNum(MyLog, MaxID, IntegrationMax);
  652.     SelectDialogItemText(MyLog, FramesID, 0, 32767);
  653.     repeat
  654.         ModalDialog(nil, item);
  655.         if item = FramesID then
  656.             FramesToAverage := GetDNum(MyLog, FramesID);
  657.         if item = SumID then begin
  658.                 SumFrames := not SumFrames;
  659.                 if SumFrames then
  660.                     IntegrateOnChip := false
  661.                 else begin
  662.                         FixIntegrationScale := false;
  663.                         ShowIntegratedValues := false;
  664.                     end;
  665.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  666.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  667.                 SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  668.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  669.             end;
  670.         if item = VideoRateID then begin
  671.                 VideoRateAveraging := not VideoRateAveraging;
  672.                 if VideoRateAveraging then
  673.                     IntegrateOnChip := false;
  674.                 SetDlogItem(mylog, VideoRateID, ord(VideoRateAveraging));
  675.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  676.             end;
  677.         if item = ShowID then begin
  678.                 ShowIntegratedValues := not ShowIntegratedValues;
  679.                 if ShowIntegratedValues then begin
  680.                         SumFrames := true;
  681.                         IntegrateOnChip := false;
  682.                     end;
  683.                 SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  684.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  685.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  686.             end;
  687.         if item = FixID then begin
  688.                 FixIntegrationScale := not FixIntegrationScale;
  689.                 if FixIntegrationScale then begin
  690.                         SumFrames := true;
  691.                         IntegrateOnChip := false;
  692.                     end;
  693.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  694.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  695.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  696.             end;
  697.         if (item = MinID) or (item = MaxID) then begin
  698.                 if item = MinID then
  699.                     IntegrationMin := GetDNum(MyLog, MinID)
  700.                 else
  701.                     IntegrationMax := GetDNum(MyLog, MaxID);
  702.                 SumFrames := true;
  703.                 FixIntegrationScale := true;
  704.                 IntegrateOnChip := false;
  705.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  706.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  707.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  708.             end;
  709.         if item = OnChipID then begin
  710.                 IntegrateOnChip := not IntegrateOnChip;
  711.                 if IntegrateOnChip then begin
  712.                         SumFrames := false;
  713.                         VideoRateAveraging := false;
  714.                         FixIntegrationScale := false;
  715.                         ShowIntegratedValues := false;
  716.                     end;
  717.                 SetDlogItem(mylog, OnChipID, ord(IntegrateOnChip));
  718.                 SetDlogItem(mylog, SumID, ord(SumFrames));
  719.                 SetDlogItem(mylog, VideoRateID, ord(VideoRateAveraging));
  720.                 SetDlogItem(mylog, FixID, ord(FixIntegrationScale));
  721.                 SetDlogItem(mylog, ShowID, ord(ShowIntegratedValues));
  722.             end;
  723.     until (item = ok) or (item = cancel);
  724.     DisposeDialog(mylog);
  725.     if FramesToAverage < 2 then
  726.         FramesToAverage := 2;
  727.     if IntegrationMin < 0 then
  728.         IntegrationMin := 0;
  729.     if IntegrationMax > 32767 then
  730.         IntegrationMax := 32767;
  731.     if VideoRateAveraging and (item <> cancel) then begin
  732.             if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) then begin
  733.                     VideoRateAveraging := false;
  734.                     PutError('Video rate averaging or summation requires a Scion LG-3 or a Scion AG-5.');
  735.                     DoAveragingOptions := false;
  736.                     exit(DoAveragingOptions);
  737.                 end;
  738.             if (FrameGrabber = ScionLG3) and (FramesToAverage > MaxLG3Frames) then begin
  739.                     FramesToAverage := MaxLG3Frames;
  740.                     DoAveragingOptions := false;
  741.                     PutError(concat('This ', long2str(MaxLG3Frames div 2), 'MB LG-3 can capture a maximum of ', long2str(MaxLG3Frames), ' frames at video rates.'));
  742.                     exit(DoAveragingOptions);
  743.                 end;
  744.             if (FrameGrabber = ScionAG5) and (FramesToAverage > 127) then begin
  745.                     FramesToAverage := 127;
  746.                     DoAveragingOptions := false;
  747.                     PutError(concat('The AG-5 can average or sum a maximum of 127 frames at video rates.'));
  748.                     exit(DoAveragingOptions);
  749.                 end;
  750.         end;
  751.     if IntegrateOnChip and (item <> cancel) then
  752.         if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) and (FrameGrabber <> ScionVG5f)  then begin
  753.                 IntegrateOnChip := false;
  754.                 PutError('On-chip integration requires a Scion frame grabber.');
  755.                 DoAveragingOptions := false;
  756.                 exit(DoAveragingOptions);
  757.             end;
  758.     DoAveragingOptions := item <> cancel;
  759. end;
  760.  
  761.  
  762.  
  763. function OddEven: boolean;
  764. {Looks at the the Field Status bit of the Status Register,
  765. which has the same address as Control Register 1. This bit is
  766. high during the odd field and low during the even field.}
  767. begin
  768.  if band(ControlReg^, $10) = $10 then
  769.   OddEven := true
  770.  else
  771.   OddEven := false;
  772. end;
  773.  
  774.  
  775. procedure WaitForOdd;
  776.  var
  777.   timeout: LongInt;
  778. begin
  779.  TimeOut := TickCount + 30;  {1/2sec. timeout}
  780.  while OddEven do
  781.   if TickCount > TimeOut then
  782.    Exit(WaitForOdd);
  783.  TimeOut := TickCount + 30;  {1/2sec. timeout}
  784.  while not OddEven do
  785.   if TickCount > TimeOut then
  786.    Exit(WaitForOdd);
  787. end;
  788.  
  789.  
  790. procedure IntegrateOn;
  791. {Sets bit 3 (Open Drain Output) of Control Register 1 high
  792. which pulls pin 11 of the 15 pin connector low, causing the
  793. Cohu camera to start integrating.}
  794. begin
  795.  ControlReg^ := $08;
  796. end;
  797.  
  798.  
  799. procedure IntegrateOff;
  800. {Sets bit 3 of Control Register 1 low which open circuits
  801.  pin 11, causing the Cohu camera to stop integrating.}
  802. begin
  803.  ControlReg^ := $00;
  804. end;
  805.  
  806.  
  807. procedure DoOnChipIntegration;
  808. {Requires a Scion LG-3, a Cohu 4910 series camera, and a cable available from Scion.}
  809. var
  810.     i,StartTicks:LongInt;
  811.     str:str255;
  812. begin
  813.     WaitForOdd;
  814.     IntegrateOn;
  815.     StartTicks := TickCount;
  816.     for i := 1 to FramesToAverage - 1 do begin
  817.         WaitForOdd;
  818.         if (i mod 30) = 0 then
  819.             ShowAnimatedWatch;
  820.         if CommandPeriod then
  821.             leave;
  822.     end;
  823.     IntegrateOff;
  824.     GetFrame;
  825.     RealToString((TickCount - StartTicks) / 60.0, 1, 2, str);
  826.     ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', cr, str, ' seconds', cr), StartTicks, FramesToAverage);
  827.     with info^ do
  828.         CopyOffscreen(fgPixMap, osPort^.portPixMap, RoiRect, RoiRect);
  829.     UpdatePicWindow;
  830.     KillRoi;
  831.     if BlankFieldInfo <> nil then
  832.         CorrectShading;
  833.     if info^.fit<>uncalibrated then
  834.         RemoveDensityCalibration;
  835. end;
  836.  
  837.  
  838. procedure DoHardwareAveraging;
  839. {Do averaging or integration at video rates using the Scion Ag-5.}
  840. var
  841.   StartTicks,ActualMin,ActualMax:LongInt;
  842.   str1,str2:str255;
  843.   frame,i:integer;
  844.   roi:rect;
  845. begin
  846.     roi:=info^.RoiRect;
  847.     KillRoi;
  848.     if FramesToAverage > 127 then
  849.         FramesToAverage := 127;
  850.     ExternalTrigger := false;
  851.     AG5GrabMode := GrabNormal;
  852.     GetFrame;
  853.     StartTicks := TickCount;
  854.     AG5GrabMode := GrabSum;
  855.     for frame := 1 to FramesToAverage - 1 do begin
  856.             GetFrame;
  857.         end;
  858.     RealToString((TickCount - StartTicks) / 60.0, 1, 2, str2);
  859.     if not SumFrames then begin
  860.             ConstantReg^ := FramesToAverage;
  861.             AG5GrabMode := GrabDivide;
  862.             GetFrame;
  863.             AG5GrabMode := GrabNormal;
  864.             str1 := '';
  865.         end
  866.     else begin
  867.             ActualMin := Ord4(ScaleLowReg^);
  868.             ActualMax := Ord4(ScaleHighReg^);
  869.             if FixIntegrationScale then begin
  870.                     ScaleLowReg^ := integer(IntegrationMin);
  871.                     ScaleHighReg^ := integer(IntegrationMax);
  872.                 end;
  873.             AG5GrabMode := GrabScale;
  874.             GetFrame;
  875.             AG5GrabMode := GrabNormal;
  876.             if FixIntegrationScale then
  877.                 str1 := concat('min=', long2str(IntegrationMin), ' (', long2str(ActualMin), ')', cr, 'max=', long2str(IntegrationMax), ' (', long2str(ActualMax), ')', cr)
  878.             else
  879.                 str1 := concat('min=', long2str(ActualMin), cr, 'max=', long2str(ActualMax), cr)
  880.         end;
  881.     ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', cr, str1, str2, ' seconds', cr), StartTicks, FramesToAverage);
  882.     with info^ do
  883.         CopyOffscreen(fgPixMap, osPort^.portPixMap, roi, roi);
  884.     UpdatePicWindow;
  885.     if not EqualRect(roi, info^.PicRect) then
  886.         RestoreRoi;
  887.     if BlankFieldInfo <> nil then
  888.         CorrectShading;
  889.     if ShowIntegratedValues then with info^ do begin
  890.             fit := StraightLine;
  891.             nCoefficients := 2;
  892.             coefficient[2] := (ActualMax - ActualMin) / 253.0;
  893.             coefficient[1] := ActualMin - coefficient[2];
  894.             ZeroClip := false;
  895.             UpdateTitleBar;
  896.             if macro then
  897.                 GenerateValues;
  898.         end else
  899.             if SumFrames and (info^.fit<>uncalibrated) then
  900.                 RemoveDensityCalibration;
  901.     end; {DoAG5HardwareAveraging}
  902.     
  903.  
  904. procedure AverageFrames;
  905.     type
  906.         IntPtr = ^integer;
  907.         SumLineType = array[0..2047] of integer;
  908.         sptr = ^SumLineType;
  909.     var
  910.         AutoSelectAll: boolean;
  911.         SelectionSize, FrameBufferSize, offset, StartTicks: LongInt;
  912.         SumBase, src, srcbase, dst, OffscreenBase: ptr;
  913.         str1, str2: str255;
  914.         xLines, xPixelsPerLine, BytesPerLine, frame, line, pixel: integer;
  915.         aline, BlankLine: LineType;
  916.         GrabRect: rect;
  917.         hstart, vstart, wwidth, wheight: integer;
  918.         j, FramesAveraged: integer;
  919.         SrcRowBytes, DstRowBytes, i, value, MinV, MaxV, range, ActualMin, ActualMax: LongInt;
  920.         iptr: IntPtr;
  921.         FrameLine: LinePtr;
  922.         SumLine: sptr;
  923.         SaveBlankFieldInfo: InfoPtr;
  924.         myMMUMode: signedbyte;
  925. begin
  926.     with info^ do
  927.         if PictureType <> FrameGrabberType then begin
  928.                 PutError('You must have an active Camera window (created using Start Capturing) in order to average frames.');
  929.                 AbortMacro;
  930.                 exit(AverageFrames)
  931.             end;
  932.     if NotRectangular or NotinBounds then begin
  933.             AbortMacro;
  934.             exit(AverageFrames);
  935.         end;
  936.     if (not OptionKeyWasDown) and (not macro) then begin
  937.             if not DoAveragingOptions then
  938.                 exit(AverageFrames);
  939.         end;
  940.     SaveBlankFieldInfo := BlankFieldInfo;
  941.     BlankFieldInfo := nil; {We don't want to do shading correction now}
  942.     StopDigitizing;
  943.     BlankFieldInfo := SaveBlankFieldInfo;
  944.     OptionKeyWasDown := false;
  945.     if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) then
  946.         VideoRateAveraging := false;
  947.     if (FrameGrabber <> ScionLG3) and (FrameGrabber <> ScionAG5) and (FrameGrabber <> ScionVG5f) then
  948.         IntegrateOnChip := false;
  949.     ShowWatch;
  950.     ShowTriggerMessage;
  951.     AutoSelectAll := not Info^.RoiShowing;
  952.     if AutoSelectAll then
  953.         SelectAll(false);
  954.     WhatToUndo := NothingToUndo;
  955.     ContinuousHistogram := false;
  956.     ResetFrameGrabber;
  957.     if IntegrateOnChip then begin
  958.         DoOnChipIntegration;
  959.         exit(AverageFrames);
  960.     end;
  961.     if VideoRateAveraging and (FrameGrabber=ScionAg5) then begin
  962.         DoHardwareAveraging;
  963.         exit(AverageFrames);
  964.     end;
  965.     DrawLabels('Frame:', 'Total:', '');
  966.     with info^.RoiRect do
  967.         SelectionSize := (ord4(right) - left) * (bottom - top);
  968.     FrameBufferSize := SelectionSize * 2;
  969.     if FrameBufferSize > BigBufSize then begin
  970.             NumToString(FrameBufferSize div 1024, str1);
  971.             NumToString(BigBufSize div 1024, str2);
  972.             str2 := concat(str1, 'K bytes are required, but only ', str2, 'K bytes are available.');
  973.             PutError(concat('There is not enough memory to do the requested frame averaging. ', str2));
  974.             if AutoSelectAll or (BlankFieldInfo <> nil) then
  975.                 KillRoi
  976.             else
  977.                 ShowRoi;
  978.             exit(AverageFrames)
  979.         end;
  980.     WhatsOnClip := NothingOnClip;
  981.     SumBase := BigBuf;
  982.     with info^, info^.RoiRect do begin
  983.             offset := left + ord4(top) * BytesPerRow;
  984.             OffscreenBase := ptr(ord4(PicBaseAddr) + offset);
  985.             offset := left + ord4(top) * fgRowBytes;
  986.             srcbase := ptr(ord4(ptr(fgSlotBase)) + offset);
  987.             SrcRowBytes := fgRowBytes;
  988.             xLines := bottom - top;
  989.             xPixelsPerLine := right - left;
  990.             BytesPerLine := xPixelsPerLine * 2;
  991.         end; {with}
  992.     for i := 0 to BytesPerLine - 1 do
  993.         BlankLine[i] := WhiteIndex;
  994.     dst := SumBase;
  995.     for line := 1 to xLines do begin {zero buffer}
  996.             BlockMove(@BlankLine, dst, BytesPerLine);
  997.             dst := ptr(ord4(dst) + BytesPerLine);
  998.         end;
  999.     info^.title := 'Camera';
  1000.     UpdateTitleBar;
  1001.     StartTicks := TickCount;
  1002.     if VideoRateAveraging then begin
  1003.             if FramesToAverage > MaxLG3Frames then
  1004.                 FramesToAverage := MaxLG3Frames;
  1005.             ExternalTrigger := false;
  1006.             BufferReg^ := 0;
  1007.             GetFrame;
  1008.             StartTicks := TickCount - 2;
  1009.             for frame := 1 to FramesToAverage - 1 do begin
  1010.                     BufferReg^ := Frame;
  1011.                     GetFrame;
  1012.                 end;
  1013.             BufferReg^ := 0;
  1014.             RealToString((TickCount - StartTicks) / 60.0, 1, 2, str1);
  1015.             ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', crStr, str1, ' seconds', crStr), StartTicks, FramesToAverage);
  1016.         end; {if VideoRateAveraging}
  1017.     for frame := 0 to FramesToAverage - 1 do begin
  1018.             Show2Values(frame + 1, FramesToAverage);
  1019.             if VideoRateAveraging then
  1020.                 BufferReg^ := Frame
  1021.             else begin
  1022.                 GetFrame;
  1023.                 if FrameGrabber = QTvdig then with info^ do
  1024.                 CopyOffScreen(fgPixMap, osPort^.portPixMap, roiRect, roiRect);
  1025.             end;
  1026.             src := srcbase;
  1027.             dst := SumBase;
  1028.             myMMUMode := 1;
  1029.             SwapMMUMode(myMMUMode);
  1030.             for line := 1 to xLines do begin
  1031.                     AddLineToSum(src, dst, xPixelsPerLine);
  1032.                     src := ptr(ord4(src) + SrcRowBytes);
  1033.                     dst := ptr(ord4(dst) + BytesPerLine);
  1034.                 end;
  1035.             SwapMMUMode(myMMUMode);
  1036.             if CommandPeriod then begin
  1037.                     beep;
  1038.                     if AutoSelectAll then
  1039.                         KillRoi
  1040.                     else
  1041.                         ShowRoi;
  1042.                     exit(AverageFrames);
  1043.                 end;
  1044.         end; {for}
  1045.     src := SumBase;
  1046.     dst := OffscreenBase;
  1047.     DstRowBytes := info^.BytesPerRow;
  1048.     if SumFrames then begin
  1049.             MinV := 2000000000;
  1050.             MaxV := 0;
  1051.             iptr := IntPtr(src);
  1052.             for i := 1 to SelectionSize do begin
  1053.                     value := iptr^;
  1054.                     if value > MaxV then
  1055.                         MaxV := value;
  1056.                     if value < MinV then
  1057.                         MinV := value;
  1058.                     iptr := IntPtr(ord4(iptr) + 2);
  1059.                 end;
  1060.             ActualMin := MinV;
  1061.             ActualMax := MaxV;
  1062.             if FixIntegrationScale then begin
  1063.                     MinV := IntegrationMin;
  1064.                     MaxV := IntegrationMax;
  1065.                 end;
  1066.             range := MaxV - MinV;
  1067.             if range <> 0 then
  1068.                 for line := 1 to xLines do begin
  1069.                         SumLine := sptr(src);
  1070.                         FrameLine := LinePtr(dst);
  1071.                         for j := 0 to xPixelsPerLine - 1 do begin
  1072.                                 value := ord4(SumLine^[j] - MinV) * 253 div range + 1;
  1073.                                 if value < 0 then
  1074.                                     value := 0;
  1075.                                 if value > 255 then
  1076.                                     value := 255;
  1077.                                 FrameLine^[j] := value;
  1078.                             end;
  1079.                         src := ptr(ord4(src) + BytesPerLine);
  1080.                         dst := ptr(ord4(dst) + DstRowBytes);
  1081.                     end
  1082.             else
  1083.                 beep;
  1084.         end
  1085.     else
  1086.         for line := 1 to xLines do begin
  1087.                 SumLine := sptr(src);
  1088.                 FrameLine := LinePtr(dst);
  1089.                 for j := 0 to xPixelsPerLine - 1 do
  1090.                     FrameLine^[j] := SumLine^[j] div FramesToAverage;
  1091.                 src := ptr(ord4(src) + BytesPerLine);
  1092.                 dst := ptr(ord4(dst) + DstRowBytes);
  1093.             end;
  1094.     if not VideoRateAveraging then begin
  1095.             if SumFrames then begin
  1096.                     if FixIntegrationScale then
  1097.                         str1 := concat('min=', long2str(MinV), ' (', long2str(ActualMin), ')', crStr, 'max=', long2str(MaxV), ' (', long2str(ActualMax), ')', crStr)
  1098.                     else
  1099.                         str1 := concat('min=', long2str(MinV), crStr, 'max=', long2str(MaxV), crStr)
  1100.                 end
  1101.             else
  1102.                 str1 := '';
  1103.             RealToString((TickCount - StartTicks) / 60.0, 1, 2, str2);
  1104.             ShowFrameRate(concat(Long2str(FramesToAverage), ' frames', crStr, str1, str2, ' seconds', crStr), StartTicks, FramesToAverage);
  1105.         end;
  1106.     UpdatePicWindow;
  1107.     if AutoSelectAll then
  1108.         KillRoi
  1109.     else
  1110.         ShowRoi;
  1111.     if BlankFieldInfo <> nil then
  1112.         CorrectShading;
  1113.     if ShowIntegratedValues then with info^ do begin
  1114.             fit := StraightLine;
  1115.             nCoefficients := 2;
  1116.             coefficient[2] := (MaxV - MinV) / 253.0;
  1117.             coefficient[1] := MinV - coefficient[2];
  1118.             nKnownValues := 0;
  1119.             ZeroClip := false;
  1120.             UpdateTitleBar;
  1121.             if macro then
  1122.                 GenerateValues;
  1123.         end else
  1124.             if SumFrames and (info^.fit<>uncalibrated) then
  1125.                 RemoveDensityCalibration;
  1126. end;
  1127.  
  1128.  
  1129. function GetFGPixel (h, v: integer): integer;
  1130.     var
  1131.         offset: LongInt;
  1132.         p: ptr;
  1133. begin
  1134.     if FrameGrabber = QTvdig then begin
  1135.         GetFGPixel := 0;
  1136.         exit(GetFGPixel);
  1137.     end;
  1138.     with Info^ do begin
  1139.             if (h < 0) or (v < 0) or (h >= fgWidth) or (v >= fgHeight) then begin
  1140.                     GetFGPixel := WhiteIndex;
  1141.                     exit(GetFGPixel);
  1142.                 end;
  1143.             offset := ord4(v) * fgRowBytes + h;
  1144.             if offset >= ord4(fgHeight) * fgRowBytes then begin
  1145.                     GetFGPixel := WhiteIndex;
  1146.                     exit(GetFGPixel);
  1147.                 end;
  1148.             p := ptr(ord4(ptr(fgSlotBase)) + offset);
  1149.             GetFGPixel := BAND(p^, 255);
  1150.         end;
  1151. end;
  1152.  
  1153.  
  1154. procedure WaitForTrigger;
  1155. begin
  1156.     StopDigitizing;
  1157.     ShowWatch;
  1158.     case FrameGrabber of
  1159.         QuickCapture:  begin
  1160.                 ControlReg^ := BitAnd($82, 255);  {Wait for external trigger and capture one frame}
  1161.                 repeat
  1162.                 until (BitAnd(ControlReg^, $80) = $00) or Button;  {Wait for it to complete}
  1163.             end;
  1164.         ScionLG3, ScionAg5, ScionVG5f:  begin
  1165.                 ControlReg^ := $90; {Wait for external trigger and capture one frame}
  1166.                 repeat
  1167.                 until (BitAnd(ControlReg^, $80) = $80) or Button;  {Wait for it to complete}
  1168.             end;
  1169.         otherwise
  1170.             repeat
  1171.             until Button;
  1172.     end;
  1173. end;
  1174.  
  1175.  
  1176. procedure DoVideoSettingsDialog;
  1177. {Displays QuickTime video digitizer options dialog box}
  1178.     const
  1179.         grayID = 6;
  1180.         color8ID = 7;
  1181.         color24ID = 8;
  1182.         fullID = 10;
  1183.         oneHalfID = 11;
  1184.         oneQuarterID = 12;
  1185.         ntscID = 14;
  1186.         palID = 15;
  1187.         secamID =16;
  1188.         builtinID = 17;
  1189.     var
  1190.         mylog: DialogPtr;
  1191.         item, ignore: integer;
  1192.         saveScale: integer;
  1193.         saveBuiltin: boolean;
  1194.         wasDigitizing, WindowClosed: boolean;
  1195.         saveStandard: VideoDigitizerStandard;
  1196.         saveMode: VideoDigitizerMode;
  1197.         
  1198.     procedure SetCaptureModeButtons;
  1199.     begin
  1200.         SetDlogItem(mylog, grayID, ord(DigitizerMode = digitizeGrayscale));
  1201.         SetDlogItem(mylog, color8ID, ord(DigitizerMode = digitizeColor));
  1202.         SetDlogItem(mylog, color24ID, ord(DigitizerMode = digitizeRGB));
  1203.     end;
  1204.  
  1205.     procedure SetSizeButtons;
  1206.     begin
  1207.         SetDlogItem(mylog, fullID, ord(fgScale = 1));
  1208.         SetDlogItem(mylog, oneHalfID, ord(fgScale = 2));
  1209.         SetDlogItem(mylog, oneQuarterID, ord(fgScale = 4));
  1210.     end;
  1211.  
  1212.     procedure SetStandardButtons;
  1213.     begin
  1214.         SetDlogItem(mylog, ntscID, ord((DigitizerStandard = defaultStd) or (DigitizerStandard = NTSCStd)));
  1215.         SetDlogItem(mylog, palID, ord(DigitizerStandard = palStd));
  1216.         SetDlogItem(mylog, secamID, ord(DigitizerStandard = secamStd));
  1217.     end;
  1218.     
  1219. begin
  1220.     saveScale := fgScale;
  1221.     saveBuiltIn := UseBuiltinDigitizer;
  1222.     saveMode := DigitizerMode;
  1223.     saveStandard := DigitizerStandard;
  1224.     InitCursor;
  1225.     mylog := GetNewDialog(320, nil, pointer(-1));
  1226.     SetCaptureModeButtons;
  1227.     SetSizeButtons;
  1228.     SetStandardButtons;
  1229.     SetDlogItem(mylog, builtinID, ord(UseBuiltinDigitizer));
  1230.     repeat
  1231.         ModalDialog(nil, item);
  1232.         if item = grayID then begin
  1233.             DigitizerMode := digitizeGrayscale;
  1234.             SetCaptureModeButtons;
  1235.         end;
  1236.         if item = color8ID then begin
  1237.             DigitizerMode := digitizeColor;
  1238.             SetCaptureModeButtons;
  1239.         end;
  1240.         if item = color24ID then begin
  1241.             DigitizerMode := digitizeRGB;
  1242.             SetCaptureModeButtons;
  1243.         end;
  1244.         if item = fullID then begin
  1245.             fgScale := 1;
  1246.             SetSizeButtons;
  1247.         end;
  1248.         if item = oneHalfID then begin
  1249.             fgScale := 2;
  1250.             SetSizeButtons;
  1251.         end;
  1252.         if item = oneQuarterID then begin
  1253.             fgScale := 4;
  1254.             SetSizeButtons;
  1255.         end;
  1256.         if item = ntscID then begin
  1257.             DigitizerStandard := ntscStd;
  1258.             SetStandardButtons;
  1259.         end;
  1260.         if item = palID then begin
  1261.             DigitizerStandard := palStd;
  1262.             SetStandardButtons;
  1263.         end;
  1264.         if item = secamID then begin
  1265.             DigitizerStandard := secamStd;
  1266.             SetStandardButtons;
  1267.         end;
  1268.         if item = builtinID then begin
  1269.             UseBuiltinDigitizer := not UseBuiltinDigitizer;
  1270.             SetDlogItem(mylog, builtinID, ord(UseBuiltinDigitizer));
  1271.         end;
  1272.     until (item = ok) or (item = cancel);
  1273.     DisposeDialog(mylog);
  1274.     if item = cancel then begin
  1275.         fgScale := saveScale;
  1276.         UseBuiltinDigitizer := saveBuiltIn;
  1277.         DigitizerMode := saveMode;
  1278.         DigitizerStandard := saveStandard;
  1279.         exit(DoVideoSettingsDialog);
  1280.     end;
  1281.     wasDigitizing := digitizing;
  1282.     StopDigitizing;
  1283.     WindowClosed := false;
  1284.     CloseVdig;
  1285.     if (fgScale <> saveScale) or (UseBuiltinDigitizer <> saveBuiltIn) or (DigitizerStandard <> saveStandard) then begin
  1286.         SelectCameraWindow;
  1287.         with info^ do if PictureType = FrameGrabberType then begin
  1288.             changes := false;
  1289.             ignore := CloseAWindow(wptr);
  1290.             WindowClosed := true;
  1291.         end;
  1292.     end;
  1293.     if FrameGrabber = NoFrameGrabber then
  1294.         LookForVDig;
  1295.     if wasDigitizing or WindowClosed then
  1296.         StartDigitizing;
  1297. end;
  1298.  
  1299.  
  1300. procedure SetOffset (var offset, gain: integer);
  1301. begin
  1302.     if offset < 0 then
  1303.         offset := 0;
  1304.     if offset > 255 then
  1305.         offset := 255;
  1306.     if offset > gain then
  1307.         offset := gain;
  1308.     DacLow := offset;
  1309.     DacHigh := DacLow + (255 - gain);
  1310. end;
  1311.  
  1312.  
  1313. procedure SetGain (var offset, gain: integer);
  1314. begin
  1315.     if gain < 0 then
  1316.         gain := 0;
  1317.     if gain > 255 then
  1318.         gain := 255;
  1319.     if gain < DacLow then
  1320.         gain := DacLow;
  1321.     DacHigh := DacLow + (255 - gain);
  1322. end;
  1323.  
  1324.  
  1325. procedure ShowChannel;
  1326. begin
  1327.     SetDlogItem(VideoControl, FirstChannelID, ord(VideoChannel = 0));
  1328.     SetDlogItem(VideoControl, FirstChannelID + 1, ord(VideoChannel = 1));
  1329.     SetDlogItem(VideoControl, FirstChannelID + 2, ord(VideoChannel = 2));
  1330.     SetDlogItem(VideoControl, FirstChannelID + 3, ord(VideoChannel = 3));
  1331. end;
  1332.  
  1333.  
  1334. procedure UpdateVideoControl;
  1335. begin
  1336.     if VideoControl <> nil then
  1337.         SetDlogItem(VideoControl, TriggerID, ord(ExternalTrigger));
  1338. end;
  1339.  
  1340.  
  1341. procedure ShowOffsetAndGain (offset, gain: integer);
  1342.     var
  1343.         str: str255;
  1344. begin
  1345.     RealToString(offset, 3, 0, str);
  1346.     if str[1] = ' ' then
  1347.         str[1] := '0';
  1348.     if str[2] = ' ' then
  1349.         str[2] := '0';
  1350.     SetDString(VideoControl, OffsetID, str);
  1351.     RealToString(gain, 3, 0, str);
  1352.     if str[1] = ' ' then
  1353.         str[1] := '0';
  1354.     if str[2] = ' ' then
  1355.         str[2] := '0';
  1356.     SetDString(VideoControl, GainID, str);
  1357. end;
  1358.  
  1359.  
  1360. procedure ShowVideoControl;
  1361.     var
  1362.         gain: integer;
  1363. begin
  1364.     InitCursor;
  1365.     VideoControl := GetNewDialog(130, nil, pointer(-1));
  1366.     ShowChannel;
  1367.     SetDlogItem(VideoControl, InvertID, ord(InvertVideo));
  1368.     SetDlogItem(VideoControl, HighlightID, ord(HighlightSaturatedPixels));
  1369.     SetDlogItem(VideoControl, TriggerID, ord(ExternalTrigger));
  1370.     SetDlogItem(VideoControl, SyncID, ord(SyncMode = SeparateSync));
  1371.     gain := 255 - (DacHigh - DacLow);
  1372.     ShowOffsetAndGain(DacLow, gain);
  1373. end;
  1374.  
  1375.  
  1376.     function NoScion:boolean;
  1377.     var
  1378.         NotFound:boolean;
  1379.     begin
  1380.         NotFound:=(FrameGrabber <> ScionLG3) and (FrameGrabber<>ScionAg5) and (FrameGrabber<>ScionVG5f);
  1381.         if NotFound then PutError('Programmable offset and gain are only supported on Scion frame grabbers.');
  1382.         NoScion:=NotFound;
  1383.     end;
  1384.  
  1385.  
  1386.     procedure DoVideoControl (item: integer);
  1387.     var
  1388.         i: integer;
  1389.         OutOfRange, WasDigitizing: boolean;
  1390.         offset, gain, inc, count: integer;
  1391.  
  1392.  
  1393.     procedure SetVideoItem (item, value: integer);
  1394.     begin
  1395.         if VideoControl <> nil then
  1396.             SetDlogItem(VideoControl, item, value);
  1397.     end;
  1398.  
  1399. begin
  1400.     InitCursor;
  1401.     gain := 255 - (DacHigh - DacLow);
  1402.     if (item >= FirstChannelID) and (item <= (FirstChannelID + 3)) then begin
  1403.             VideoChannel := item - FirstChannelID;
  1404.             if VideoControl <> nil then
  1405.                 ShowChannel;
  1406.             if digitizing then
  1407.                 ResetFrameGrabber;
  1408.         end;
  1409.     if item = InvertID then begin
  1410.             InvertVideo := not InvertVideo;
  1411.             SetVideoItem(InvertID, ord(InvertVideo));
  1412.             if digitizing then
  1413.                 ResetFrameGrabber;
  1414.         end;
  1415.     if item = HighlightID then begin
  1416.             HighlightSaturatedPixels := not HighlightSaturatedPixels;
  1417.             SetVideoItem(HighlightID, ord(HighlightSaturatedPixels));
  1418.             if digitizing then begin
  1419.                     if HighlightSaturatedPixels then
  1420.                         HighlightPixels
  1421.                     else
  1422.                         LoadLUT(info^.ctable);
  1423.                 end;
  1424.         end;
  1425.     if item = TriggerID then begin
  1426.             ExternalTrigger := not ExternalTrigger;
  1427.             case FrameGrabber of
  1428.                 QuickCapture, ScionLG3, ScionAG5, ScionVG5f:  begin
  1429.                         WasDigitizing := digitizing;
  1430.                         StopDigitizing;
  1431.                         if ExternalTrigger and WasDigitizing then
  1432.                             StartDigitizing;
  1433.                     end;
  1434.                 otherwise
  1435.                     ExternalTrigger := false;
  1436.             end;
  1437.             SetVideoItem(TriggerID, ord(ExternalTrigger));
  1438.         end;
  1439.     if item = SyncID then begin
  1440.             if SyncMode <> SeparateSync then
  1441.                 SyncMode := SeparateSync
  1442.             else
  1443.                 SyncMode := NormalSync;
  1444.             case FrameGrabber of
  1445.                 ScionLG3, ScionAG5, ScionVG5f: 
  1446.                     if digitizing then
  1447.                         ResetFrameGrabber;
  1448.                 QuickCapture:  begin
  1449.                         PutError('Sync is not under program control on the QuickCapure card.');
  1450.                         SyncMode := NormalSync;
  1451.                         AbortMacro;
  1452.                     end;
  1453.                 otherwise
  1454.                     ;
  1455.             end;
  1456.             SetVideoItem(SyncID, ord(SyncMode = SeparateSync));
  1457.         end;
  1458.     if (item >= OffsetUpID) and (item <= GainDownID) then begin
  1459.             if NoScion then exit(DoVideoControl);
  1460.             offset := DacLow;
  1461.             inc := 1;
  1462.             count := 0;
  1463.             repeat
  1464.                 count := count + 1;
  1465.                 if count > 2 then
  1466.                     inc := 2;
  1467.                 if count > 4 then
  1468.                     inc := 5;
  1469.                 if count > 8 then
  1470.                     inc := 10;
  1471.                 case item of
  1472.                     OffsetUpID:  begin
  1473.                             offset := offset + inc;
  1474.                             SetOffset(offset, gain);
  1475.                         end;
  1476.                     OffsetDownID:  begin
  1477.                             offset := offset - inc;
  1478.                             SetOffset(offset, gain);
  1479.                         end;
  1480.                     GainUpID:  begin
  1481.                             gain := gain + inc;
  1482.                             SetGain(offset, gain);
  1483.                         end;
  1484.                     GainDownID:  begin
  1485.                             gain := gain - inc;
  1486.                             SetGain(offset, gain);
  1487.                         end;
  1488.                 end; {case}
  1489.                 ShowOffsetAndGain(DacLow, gain);
  1490.                 if Digitizing and (count > 1) then begin
  1491.                         DacLowReg^ := DacLow;
  1492.                         DacHighReg^ := DacHigh;
  1493.                         CaptureAndDisplayFrame;
  1494.                         if ContinuousHistogram then begin
  1495.                                 ShowContinuousHistogram;
  1496.                                 DrawHistogram
  1497.                             end
  1498.                     end
  1499.                 else
  1500.                     wait(5);
  1501.             until not button;
  1502.         end;
  1503.     if item = ResetID then begin
  1504.             if NoScion then exit(DoVideoControl);
  1505.             if FrameGrabber=ScionLG3 then begin
  1506.                 DacLow := DefaultLG3DacLow;
  1507.                 DacHigh := DefaultLG3DacHigh;
  1508.             end else if FrameGrabber = ScionAG5 then begin
  1509.                 DacLow := DefaultAG5DacLow;
  1510.                 DacHigh := DefaultAG5DacHigh;
  1511.             end else begin
  1512.                 DacLow := DefaultVG5DacLow;
  1513.                 DacHigh := DefaultVG5DacHigh;
  1514.             end;
  1515.             gain := 255 - (DacHigh - DacLow);
  1516.             ParamText(long2str(DacLow), long2str(gain), '', '');
  1517.             ShowOffsetAndGain(DacLow, gain);
  1518.         end;
  1519.     if FramesToAverage < 2 then
  1520.         FramesToAverage := 2;
  1521.     if (FrameGrabber = ScionLG3) or (FrameGrabber=ScionAG5) or (FrameGrabber=ScionVG5f) then begin
  1522.             DacLowReg^ := DacLow;
  1523.             DacHighReg^ := DacHigh;
  1524.         end;
  1525. end;
  1526.  
  1527.  
  1528. procedure ShowVideoDialog;
  1529. begin
  1530.     if FrameGrabber = noFrameGrabber then
  1531.         LookForVDig;
  1532.     if FrameGrabber = QTvdig then
  1533.         doVideoSettingsDialog
  1534.     else begin
  1535.         if VideoControl = nil then
  1536.             ShowVideoControl
  1537.         else
  1538.             SelectWindow(VideoControl);
  1539.     end;
  1540. end;
  1541.  
  1542. end.